home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / telecom / 46 / pascal / pager.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-08-15  |  26.4 KB  |  949 lines
  1. {
  2.   pager.pas is a demonstration of the GEM interface, as exercised
  3.   by OSS Personal Pascal.  Pager.pas is in the public domain, and
  4.   may be used for any purpose, so long as the author is acknowledged.
  5.  
  6.   Martin Fouts
  7. }
  8.  
  9. PROGRAM pager;
  10.  
  11. CONST
  12.   {$I GEMCONST.PAS}
  13.   SUPER_MODE = $20;  { GEMDOS call number to enter supervisor mode }
  14.   Max_Wind = 10;
  15.   Delay = 10000; { Time between timeouts (in milliseconds) }
  16.   Max_Char = 80;
  17.  
  18. TYPE
  19.   {$I GEMTYPE.PAS}
  20.   Wind_No = 1..Max_Wind;
  21.   { Ubuffer = packed array [1..Max_Char] of char;}
  22.   UBuffer = string [255];
  23.   UTPtr = ^Utext;
  24.   Utext = Record
  25.     Prev, Next : UTPtr;
  26.     Uline : Ubuffer;
  27.   End;
  28.   UFile = packed File of char;
  29.   Wind_Rec = Record
  30.     Handle : integer;    { GEM Handle from New_Window }
  31.     InUse : boolean;     { True if this record is in use }
  32.     Title : string;      { Contents of title bar }
  33.     Full : boolean;      { True if last click on full made full window }
  34.     Ufp : UFile;         { File associated with window }
  35.     Ufirst : UTPtr;      { Start of data from this file }
  36.     Ulast : UTPtr;       { End of data from this file }
  37.     UCurrent : UTPtr;    { First line of current screen }
  38.     UCharNo : integer;   { First character of current screen (zero based )}
  39.     ULineNo : integer;   { First line of current screen }
  40.     UWide : integer;     { Width of widest line in this file }
  41.     UHigh : integer;     { Number of lines read in }
  42.     LWide : integer;     { Number of characters wide }
  43.     LHigh : integer;     { Number of characters high }
  44.     X_percent : 0..1000; { Position of slider, initially 0 }
  45.     Y_percent : 0..1000; { Position of slider, initially 0 }
  46.     Ended : boolean;     { True if EOF(Ufp) has occured }
  47.     { Current coordinates }
  48.     windx, windy, windw, windh : integer;
  49.     { Last coordinates less than full size }
  50.     smallx, smally, smallw, smallh : integer;
  51.     { Coordinates of working space }
  52.     workx, worky, workw, workh : integer;
  53.   end;
  54.   Wind_Array = array[Wind_No] of Wind_Rec;
  55.  
  56. VAR
  57.   wind : Wind_Array;    { Track the windows we are using }
  58.   running : boolean;    { Set to false to quit execution }
  59.   pathname : string;    { Default search path for file opens }
  60.   filename : string;    { Filename returned by select file }
  61.   mymenu : Menu_Ptr;    { Pointer to menu for this program }
  62.   mytitle : Integer;    { Pointer to first (only) title bar in menu }
  63.   Item1 : Integer;      { First (open) item in File menu }
  64.   Item2 : Integer;      { Second (close) item in File menu }
  65.   Item3 : Integer;      { Third (quit) item in File menu }
  66.   B_Left : Integer;     { Status of Left Button, 0 = up, 1 = down }
  67.   InWindow : Boolean;   { True if in the front (active) window }
  68.   Timeouts : Integer;   { Count the number of timeouts }
  69.   cw, ch : Integer;     { Width and Height of a character }
  70.   bw, bh : Integer;     { Width and Height of a box around a char }
  71.   ticks : long_integer; { Timer count at start of program }
  72.   mouse_init : Boolean; { True if mouse has been initialized }
  73.   menu_init : Boolean;  { True if menu has been initialized }
  74.  
  75. {$I GEMSUBS.PAS}
  76. {$I PEEKPOKE.PAS}
  77. {$I STRVAL.PAS}
  78.  
  79. FUNCTION min (x, y : integer) : integer;
  80. BEGIN
  81.   if (x < y)
  82.   THEN min := x
  83.   ELSE min := y;
  84. END;
  85.  
  86. FUNCTION max (x, y : integer) : integer;
  87. BEGIN
  88.   if (x > y)
  89.   THEN max := x
  90.   ELSE max := y;
  91. END;
  92.  
  93. PROCEDURE Update_Slides(VAR wind : Wind_Rec);
  94. VAR
  95.   XSize : Integer;
  96.   YSize : Integer;
  97.  
  98.   FUNCTION Kof(X,Y:integer) : integer;
  99.   { Returns X div Y, normalized to the range 0-1000,
  100.     excess values are 'clipped' to the endpoints of the range }
  101.   VAR
  102.     Ftemp1 : real;
  103.     Ftemp2 : real;
  104.     Itemp : Integer;
  105.   BEGIN
  106.     { These calculations are done this way to avoid integer overflow
  107.       and preserve decimal places. }
  108.     IF (Y = 0) { Avoid divide by zero errors }
  109.       THEN Kof := 0
  110.       ELSE
  111.         BEGIN
  112.           Ftemp1 := X;
  113.           Ftemp2 := Y;
  114.           ITemp := Trunc((Ftemp1 / Ftemp2) * 1000.0);
  115.           Kof := MAX(MIN(1000,Itemp),1);
  116.         END;
  117.   END;
  118.  
  119. BEGIN
  120.   WITH wind DO
  121.   BEGIN
  122.     work_rect(handle,WorkX,WorkY,WorkW,WorkH);
  123.     sys_font_size(cw,ch,bw,bh);
  124.     LWide := WorkW div cw; { convert pixel size to character size }
  125.     LHigh := WorkH div ch;
  126.     { Calculate position and size of horizontal elevator }
  127.     X_Percent := Kof(UCharNo+1,UWide);
  128.     XSize := Kof(LWide,UWide);
  129.     { Calculate position and size of vertical elevator }
  130.     IF (Ended)
  131.       THEN
  132.         BEGIN  { Actually know length of file, so use real values }
  133.           Y_Percent := Kof(UlineNo,Uhigh);
  134.           YSize := Kof(LHigh,UHigh);
  135.         END
  136.       ELSE
  137.         BEGIN  { Don't know length, allow one page of end room }
  138.           Y_Percent := Kof(UlineNo,(Uhigh+Lhigh));
  139.           YSize := Kof(LHigh,(UHigh+Lhigh));
  140.         END;
  141.     { Now set the elevator position and size }
  142.     Wind_Set(handle,WF_HSlSize,XSize,0,0,0);
  143.     Wind_Set(handle,WF_VSlSize,YSize,0,0,0);
  144.     Wind_Set(handle,WF_HSlide,X_percent,0,0,0);
  145.     Wind_Set(handle,WF_VSlide,Y_percent,0,0,0);
  146.   END;
  147. END;
  148.  
  149. FUNCTION super( sp: long_integer) : long_integer;
  150.   GEMDOS($20);
  151.  
  152. FUNCTION Get_timer : long_integer;
  153. VAR
  154.   ssp : long_integer;
  155. BEGIN
  156.   ssp := super(0);
  157.   Get_timer := 5*lpeek($4ba);
  158.   ssp := super(ssp);
  159. END;
  160.  
  161. PROCEDURE Get_String(VAR Ufd:Ufile; VAR Uline:Ubuffer;
  162.                      VAR Ended : boolean);
  163. { Read a carriage return terminated string and return it with
  164.   the carriage return replaced by null }
  165. VAR
  166.   i : integer;
  167.   c : char;
  168. BEGIN
  169.   i := 0;
  170.   c := chr(0);
  171.   ended := false;
  172.   WHILE (i < Max_Char) AND (c <> chr(13)) AND (NOT Ended) DO
  173.   BEGIN
  174.     c := Ufd^;
  175.     i := i + 1;
  176.     Uline[i] := c;
  177.     Ended := Eof(Ufd);
  178.     IF NOT Ended THEN get(Ufd);
  179.   END;
  180.   Ended := Eof(Ufd);
  181.   IF NOT Ended THEN get(Ufd); { Skip the linefeed }
  182.   Uline[0] := chr(i);
  183.   If i = 0 THEN i := 1;
  184.   Uline[i] := chr(0);
  185. END;
  186.  
  187. PROCEDURE Init_Menu;
  188. { Set up the Menu.  GEM Requires all titles first, then all items
  189.   IN ORDER within Title. }
  190. BEGIN
  191.   menu_init := true;
  192.   mymenu := New_Menu(10, ' About Pager');
  193.   mytitle := Add_MTitle(mymenu,' FILE ');
  194.   Item1 :=   Add_MItem(mymenu,mytitle,' Open ');
  195.   Item2 :=   Add_MItem(mymenu,mytitle,' Close ');
  196.   Item3 :=   Add_MItem(mymenu,mytitle,' Quit ');
  197.   Draw_Menu(mymenu);
  198. END;
  199.  
  200. FUNCTION Match_Window(new_handle : integer) : integer;
  201. { Find the window record for the specified handle. Return 0 if not found }
  202. VAR
  203.  i, n : Integer;
  204. BEGIN
  205.   n := 0;
  206.   FOR i := 1 to Max_Wind DO
  207.     IF (Wind[i].handle = new_handle) THEN n := i;
  208.   Match_Window := n;
  209. END;
  210.  
  211. PROCEDURE Redraw_Text(handle,x,y,w,h:integer);
  212. VAR
  213.   i : integer;
  214.   lines : integer;
  215.   lineno : integer;
  216.   ptr : UTPtr;
  217.   finished : boolean;
  218. BEGIN
  219.   i := Match_Window(handle);
  220.   Set_Clip(x,y,w,h);
  221.   WITH Wind[i] DO
  222.   BEGIN
  223.     Work_Rect(handle,x,y,w,h);
  224.     lines := h div ch;
  225.     ptr := Ucurrent;
  226.     lineno := 1;
  227.     finished := false;
  228.     WHILE (lineno <= lines) AND (NOT finished) DO
  229.       BEGIN
  230.         IF (Ptr = nil)
  231.         THEN
  232.           BEGIN
  233.             IF (NOT Ended) THEN
  234.               BEGIN
  235.                 New(ptr);
  236.                 Get_String(Ufp,Ptr^.Uline,Ended);
  237.                 Draw_String(cw*(-UCharNo),ch*lineno,Ptr^.Uline);
  238.                 Uhigh := Uhigh + 1;
  239.                 Uwide := MAX(UWide,Length(Ptr^.Uline));
  240.                 ptr^.prev := Ulast;
  241.                 Ulast^.next := ptr;
  242.                 Ulast := ptr;
  243.                 ptr^.next := nil;
  244.                 ptr := ptr^.next;
  245.               END;
  246.             finished := Ended;
  247.           END
  248.         ELSE
  249.           BEGIN
  250.             Draw_String(cw*(-UCharNo),ch*lineno,Ptr^.Uline);
  251.             Ptr := Ptr^.next;
  252.           END;
  253.         lineno := lineno + 1;
  254.       END;
  255.   END;
  256.   Update_Slides(wind[i]);
  257. END;
  258.  
  259. FUNCTION Free_Window : integer;
  260. { Find an unused window. Returns 0 if none available. }
  261. VAR
  262.   i : Integer;
  263.   found : Boolean;
  264. BEGIN
  265.   found := False;
  266.   i := 1;
  267.   WHILE (i < Max_wind) AND (NOT found) DO
  268.   BEGIN
  269.     found := NOT wind[i].InUse;
  270.     i := i + 1;
  271.   END;
  272.   IF found
  273.     THEN Free_Window := i - 1
  274.     ELSE Free_Window := 0;
  275. END;
  276.  
  277. PROCEDURE Make_Window(VAR wind : Wind_Rec);
  278.  { Build the data structures for a window }
  279. BEGIN
  280.   WITH wind DO
  281.   BEGIN
  282.     InWindow := false;
  283.     B_Left := 0;
  284.     title := filename;
  285.     handle := New_Window(G_All,title,0,0,0,0);
  286.     full := true;
  287.     InUse := true;
  288.     UWide := 0;
  289.     UHigh := 0;
  290.     X_percent := 0;
  291.     Y_percent := 0;
  292.     ULineNo := 0;
  293.     Ufirst := nil;
  294.     ULast := nil;
  295.     UCurrent := nil;
  296.     UCharNo := 0;
  297.     Ended := False;
  298.   END;
  299. END;
  300.  
  301. PROCEDURE Draw_Window(VAR wind : Wind_Rec);
  302.  { Draw the window on the screen }
  303. VAR
  304.   x, y, w, h : Integer;
  305. BEGIN
  306.   WITH wind DO
  307.   BEGIN
  308.     Begin_Update;
  309.     Hide_Mouse;
  310.     Open_Window(handle,0,0,0,0);
  311.     Set_Window(handle);
  312.     Bring_To_Front(handle);
  313.     Work_rect(handle,workx,worky,workw,workh);
  314.     Set_Clip(workx,worky,workw,workh);
  315.     smallx := workx;
  316.     smally := worky;
  317.     smallw := workw div 2;
  318.     smallh := workh div 2;
  319.     Update_Slides(wind);
  320.     Show_Mouse;
  321.     End_Update;
  322.   END;
  323. END;
  324.  
  325. PROCEDURE Update_window(handle : integer);
  326. VAR
  327.   x, y, w, h : Integer;
  328.   x0, y0, w0, h0 : Integer;
  329. BEGIN
  330.   Begin_Update;
  331.   Hide_Mouse;
  332.   Work_Rect(handle,x0,y0,w0,h0);
  333.   First_Rect(handle,x,y,w,h);  { Locate an area in need of update }
  334.   WHILE (w <> 0) OR (h <> 0) DO
  335.     BEGIN               { For each area of the window }
  336.       Paint_Rect(x-x0,y-y0,w,h); { need to convert absolute to }
  337.       Redraw_Text(handle,x,y,w,h);
  338.       Next_Rect(handle,x,y,w,h); { Find another rectangle to test }
  339.   END;
  340.   Show_Mouse;
  341.   End_Update;
  342. END;
  343.  
  344. PROCEDURE prev_window(VAR wind : Wind_rec; lines : integer);
  345. VAR
  346.   lineno : integer;
  347.   ptr : UTPtr;
  348. BEGIN
  349.   WITH wind DO
  350.   BEGIN
  351.     work_rect(handle,workx,worky,workw,workh);
  352.     Paint_Rect(0,0,workw,workh);
  353.     ptr := UCurrent;
  354.     IF (ptr <> NIL) THEN
  355.       WHILE (lines > 0) AND (ptr^.prev <> nil) DO
  356.         BEGIN
  357.           lines := lines - 1;
  358.           ULineNo := ULineNo - 1;
  359.           ptr := ptr^.prev;
  360.         END;
  361.     UCurrent := ptr;
  362.     Update_window(handle);
  363.   END;
  364. END;
  365.  
  366. PROCEDURE next_window(VAR wind : Wind_rec; lines : integer);
  367. VAR
  368.   lineno : INTEGER;
  369.   Ptr : UTPtr;
  370. BEGIN
  371.   WITH wind DO
  372.   BEGIN
  373.     work_rect(handle,workx,worky,workw,workh);
  374.     Paint_Rect(0,0,workw,workh);
  375.     lineno := 1;
  376.     ptr := Ucurrent;
  377.     IF (ptr <> NIL) THEN
  378.       WHILE (lineno <= lines) AND (Ptr^.next <> nil) DO
  379.         BEGIN
  380.           ptr := ptr^.next;
  381.           lineno := lineno + 1;
  382.           ULineNo := ULineNo + 1;
  383.         END;
  384.     UCurrent := ptr;
  385.     Update_Window(handle);
  386.   END;
  387. END;
  388.  
  389. PROCEDURE fill_window(VAR wind : Wind_rec);
  390. VAR
  391.   lines : INTEGER;
  392.   lineno : INTEGER;
  393.   Ptr : UTPtr;
  394. BEGIN
  395.   WITH wind DO
  396.   BEGIN
  397.     lines := LHigh;
  398.     reset(Ufp,filename); { Open the file for reading }
  399.     lineno := 1;
  400.     WHILE (lineno <= lines) AND (NOT ended) DO
  401.       BEGIN
  402.         new(Ptr);
  403.         If (UFirst = nil) THEN UFirst := Ptr;
  404.         Ptr^.Prev := Ucurrent;
  405.         IF (UCurrent <> Nil) THEN Ucurrent^.Next := Ptr;
  406.         Ptr^.Next := Nil;
  407.         UCurrent := Ptr;
  408.         Get_String(Ufp,Ptr^.Uline,Ended);
  409.         lineno := lineno + 1;
  410.         UHigh := UHigh + 1;
  411.         UWide := MAX(UWide,Length(Ptr^.Uline));
  412.       END;
  413.     ULast := UCurrent;
  414.     UCurrent := UFirst;
  415.   END;
  416.   UPdate_Slides(wind);
  417. END;
  418.  
  419. FUNCTION Init_Window : Boolean;
  420. { Attempt to create a new window and open a file.  Returns false if aborted by
  421.   the filename dialog, or if there are no windows left }
  422. VAR
  423.   n : Integer;
  424.   temp : Boolean;
  425.   i : integer;
  426.   trying : Boolean;
  427. PROCEDURE IO_CHECK(flag:boolean); EXTERNAL;
  428. FUNCTION IO_RESULT : INTEGER; EXTERNAL;
  429. BEGIN
  430.   n := Free_Window;  { Find a window record for this window }
  431.   temp := n > 0;
  432.   IF NOT temp      { No window available, so fail }
  433.     THEN n := Do_Alert('[3][No More Windows][ OK ]',1)
  434.          { Have a window, so look for a file spec }
  435.     ELSE
  436.       BEGIN
  437.         trying := Get_In_file(pathname,filename);
  438.         WHILE Trying DO
  439.           BEGIN  { Try to open the specified file }
  440.             IO_Check(false);       { We want to handle I/O problems }
  441.             reset(wind[n].Ufp,filename);
  442.             i := IO_Result;
  443.             IO_check(true);
  444.             if (i = 0)
  445.               THEN
  446.                 BEGIN
  447.                   temp := true;
  448.                   trying := false;
  449.                 END
  450.               ELSE
  451.                 BEGIN
  452.                   i := Do_Alert('[3][Open failed!][ OK ]',1);
  453.                   temp := Get_In_file(pathname,filename);
  454.                   trying := temp;
  455.                 END;
  456.           END;
  457.       END;
  458.   IF temp THEN  { Set up the window }
  459.     BEGIN
  460.       Make_Window(wind[n]);
  461.       Draw_Window(wind[n]);
  462.       Fill_Window(wind[n]);
  463.     END;
  464.   Init_Window := temp;
  465. END;
  466.  
  467. PROCEDURE Start_up;
  468. { Initialize the mouse and the menu and open the first window }
  469. VAR
  470.   i : integer;
  471.   x, y, w, h : Integer;
  472. BEGIN
  473.   { First, give user a chance to bag the program }
  474.   i := Do_Alert(
  475.      '[1][ File Pager | A Program by Martin Fouts ][ Ready | Cancel ]',2);
  476.   running := (i = 1);
  477.   pathname := 'A:*.*';
  478.   mouse_init := false;
  479.   menu_init := false;
  480.   IF running THEN
  481.     BEGIN
  482.       Init_Menu;
  483.       Init_Mouse;
  484.       mouse_init := true;
  485.       Sys_Font_Size(cw,ch,bw,bh);
  486.       Paint_Color(White);
  487.       running := Init_Window;
  488.       timeouts := 0;
  489.       ticks := Get_timer; { What time is it? }
  490.     END;
  491. END;
  492.  
  493. PROCEDURE Process;
  494. { Where the work gets done.  Handle a keyboard or message event }
  495. VAR
  496.   i : integer;
  497.   message : Message_Buffer;  { These are all returned by get_event }
  498.   key : Integer;
  499.   bcnt : Integer;
  500.   bstate : Integer;
  501.   mx : Integer;
  502.   my : Integer;
  503.   kbd_state : Integer;
  504.   Cur_X, Cur_Y, Cur_W, Cur_H : Integer;
  505.  
  506.   PROCEDURE Do_Message;   { Process a Message event }
  507.  
  508.     PROCEDURE Close_It(n:Integer); { Close a window }
  509.     VAR
  510.       windno, x0, y0, w0, h0 : Integer;
  511.     BEGIN
  512.       Close_Window(n);
  513.       Delete_Window(n);
  514.       Set_Window(Front_Window);
  515.       Work_Rect(Front_Window, x0, y0, w0, h0);
  516.       Set_Clip(x0, y0, w0, h0);
  517.       windno := Match_Window(n);
  518.       WITH Wind[windno] DO
  519.         BEGIN
  520.           InUse := False;
  521.           Close(Ufp);
  522.           IF (UFirst <> Nil) THEN
  523.             WHILE (Ufirst <> Nil) DO
  524.               BEGIN
  525.                 UCurrent := Ufirst^.Next;
  526.                 Dispose(Ufirst);
  527.                 UFirst := UCurrent;
  528.               END;
  529.         END;
  530.     END;
  531.  
  532.     PROCEDURE Do_Selection; { Process a menu selection event }
  533.  
  534.     VAR
  535.       temp : integer;
  536.  
  537.       PROCEDURE Menu_Open; { File Menu Open Item selected }
  538.       VAR
  539.         temp : boolean;
  540.       BEGIN
  541.         temp := Init_Window;   { Open A Window }
  542.       END;
  543.  
  544.       PROCEDURE Menu_Close; { File Menu Close Item selected }
  545.       BEGIN
  546.         Close_It(Front_Window);
  547.       END;
  548.  
  549.       PROCEDURE Menu_Quit;  { File Menu Quit Item selected }
  550.       VAR                   { Use an alert to verify the Quit }
  551.         temp : integer;
  552.       BEGIN
  553.         temp :=
  554.           Do_Alert('[3][ Do you really want to Quit? ][ Quit | Continue ]',2);
  555.           running := (temp <> 1);  { Return FALSE to Quit! }
  556.       END;
  557.  
  558.     BEGIN
  559.       Menu_Normal(mymenu,message[3]); { Turn off menu highlight }
  560.       IF (message[3] = 3) THEN  { Special case, the INFO box }
  561.         temp := Do_Alert('[1][A Sample Program][ OK ]',0)
  562.       ELSE IF (message[4] = item1) THEN Menu_Open
  563.       ELSE IF (message[4] = item2) THEN Menu_Close
  564.       ELSE IF (message[4] = item3) THEN Menu_Quit;
  565.     END; { Procedure Do_Selection }
  566.  
  567.     PROCEDURE Do_Redraw;  { Handle a redraw message }
  568.     VAR
  569.      temp, x, y, w, h : Integer;
  570.      x0, y0, w0, h0 : Integer;
  571.     BEGIN
  572.       Begin_Update;        { Prevent interference }
  573.       Hide_Mouse;          { Keep the mouse out of the way }
  574.       temp := Get_Window;  { Remember the active window }
  575.       Set_Window(message[3]); { Make the updated window active }
  576.       Work_Rect(message[3],x0,y0,w0,h0); { Find out about it }
  577.       Set_Clip(x0,y0,w0,h0);
  578.       First_Rect(message[3],x,y,w,h);  { Locate an area in need of update }
  579.       WHILE (w <> 0) OR (h <> 0) DO
  580.         BEGIN               { For each area of the window }
  581.           IF Rect_Intersect(message[4],message[5],message[6],message[7],
  582.                             x,y,w,h) THEN
  583.             BEGIN           { Find the area which must be updated and do so }
  584.               Paint_Rect(x-x0,y-y0,w,h); { need to convert absolute to }
  585.               Redraw_Text(message[3],x,y,w,h);
  586.             END;                         { relitive coordinates for Paint }
  587.           Next_Rect(message[3],x,y,w,h); { Find another rectangle to test }
  588.         END;
  589.       Show_Mouse;           { Make the mouse active again }
  590.       End_Update;           { Allow GEM activity again }
  591.       Set_Window(temp);     { Restore the active window }
  592.       Work_Rect(temp,x0,y0,w0,h0);
  593.       Set_Clip(x0,y0,w0,h0); { And set it up as the i/o port }
  594.     END;
  595.  
  596.     PROCEDURE Do_Newtop;     { Bring a new window to the top }
  597.     BEGIN
  598.       Bring_To_Front(message[3]);
  599.       Set_Window(message[3]);
  600.     END;
  601.  
  602.     PROCEDURE Do_Close;       { Close a window (and it's file) }
  603.     BEGIN
  604.       Close_It(message[3]);
  605.     END;
  606.  
  607.     PROCEDURE Do_Fulled;      { Handle a click on the full box }
  608.     var
  609.       n, x, y, w, h : integer;
  610.     BEGIN
  611.       n := Match_Window(message[3]);  { Find the window }
  612.       WITH wind[n] DO
  613.         BEGIN
  614.           IF Wind[n].Full     { If already full then shrink the window }
  615.           THEN
  616.             BEGIN
  617.               Set_WSize(handle, smallx, smally, smallw, smallh);
  618.               windx := smallx;
  619.               windy := smally;
  620.               Windw := smallw;
  621.               windh := smallh;
  622.             END
  623.           ELSE
  624.             BEGIN                  { If small make largest size possible }
  625.               Wind_Get(handle,WF_FullXYWH,windx,windy,windw,windh);
  626.               Set_Wsize(handle,windx,windy,windw,windh);
  627.             END;
  628.           Full := NOT Full;    { Swap the full mode }
  629.           Update_Slides(wind[n]);
  630.         END;
  631.     END;
  632.  
  633.     PROCEDURE Do_Arrowed;      { Handle an arrow being clicked }
  634.     VAR
  635.       n : integer;
  636.  
  637.       PROCEDURE Page_up;
  638.       BEGIN
  639.         prev_window(wind[n],wind[n].Lhigh);
  640.       END;
  641.  
  642.       PROCEDURE Page_down;
  643.       BEGIN
  644.         next_window(wind[n],wind[n].Lhigh);
  645.       END;
  646.  
  647.       PROCEDURE Row_up;
  648.       BEGIN
  649.         WITH wind[n] DO
  650.           BEGIN
  651.             if (Ucurrent <> nil) THEN
  652.               if (Ucurrent^.prev <> nil) THEN
  653.                 BEGIN
  654.                   Ucurrent := Ucurrent^.prev;
  655.                   update_window(handle);
  656.                   ULineno := ULineno - 1;
  657.                 END;
  658.           END;
  659.       END;
  660.  
  661.       PROCEDURE Row_down;
  662.       BEGIN
  663.         WITH wind[n] DO
  664.           BEGIN
  665.             if (Ucurrent <> nil) THEN
  666.               if (Ucurrent^.next <> nil) THEN
  667.                 BEGIN
  668.                   Ucurrent := Ucurrent^.next;
  669.                   update_window(handle);
  670.                   ULineno := ULineno + 1;
  671.                 END;
  672.           END;
  673.       END;
  674.  
  675.       PROCEDURE Page_left;
  676.       BEGIN
  677.         WITH wind[n] DO
  678.           BEGIN
  679.             if (UCharNo >= Lwide)
  680.               THEN UCharNo := UCharNo - Lwide
  681.               ELSE UCharNo := 1;
  682.             update_window(handle);
  683.           END;
  684.       END;
  685.  
  686.       PROCEDURE Page_right;
  687.       BEGIN
  688.         WITH wind[n] DO
  689.           BEGIN
  690.             if (wind[n].UCharNo <= (Uwide - Lwide - 2))
  691.               THEN UCharNo := UCharNo + LWide
  692.               ELSE UcharNo := Uwide - Lwide - 2;
  693.             update_window(handle);
  694.           END;
  695.       END;
  696.  
  697.       PROCEDURE Column_left;
  698.       BEGIN
  699.         if (wind[n].UCharNo > 0 ) THEN
  700.           BEGIN
  701.             wind[n].UCharNo := wind[n].UCharNo - 1;
  702.             update_window(wind[n].handle);
  703.           END;
  704.       END;
  705.  
  706.       PROCEDURE Column_right;
  707.       BEGIN
  708.         WITH wind[n] DO
  709.           BEGIN
  710.             if (UCharNo <= (Uwide - Lwide)) THEN
  711.               BEGIN
  712.                 UCharNo := UCharNo + 1;
  713.                 update_window(handle);
  714.               END;
  715.           END;
  716.       END;
  717.  
  718.       PROCEDURE No_move;
  719.       BEGIN
  720.       END;
  721.  
  722.     BEGIN
  723.       n := Match_window(message[3]);
  724.       CASE message[4] OF
  725.         0: Page_up;
  726.         1: Page_down;
  727.         2: Row_up;
  728.         3: Row_down;
  729.         4: Page_left;
  730.         5: Page_right;
  731.         6: Column_left;
  732.         7: Column_right;
  733.         OTHERWISE: No_move;
  734.       END;
  735.     END;
  736.  
  737.     FUNCTION NofK(X,Y:integer) : integer;
  738.     VAR
  739.       temp1, temp2 : real;
  740.     BEGIN
  741.       temp1 := X;
  742.       temp1 := temp1 / 1000.0;
  743.       temp2 := Y;
  744.       NofK := trunc(temp1*temp2) - 1;
  745.     END;
  746.  
  747.     PROCEDURE Do_Hor;  { Horizontal slider movement }
  748.     VAR
  749.       n : integer;
  750.     BEGIN
  751.       n := Match_Window(message[3]);
  752.       WITH wind[n] DO
  753.         BEGIN
  754.           UCharno := NofK(message[4],Uwide);
  755.           update_window(handle);
  756.         END;
  757.     END;
  758.  
  759.     PROCEDURE Do_Ver;  { Vertical slider movement }
  760.     VAR
  761.       n : integer;
  762.       newline : integer;
  763.     BEGIN
  764.       n := Match_Window(message[3]);
  765.       WITH wind[n] DO
  766.         BEGIN
  767.           newline := NofK(message[4],Uhigh);
  768.           IF (newline < Ulineno)
  769.             THEN prev_window(wind[n],Ulineno-newline)
  770.             ELSE
  771.               IF (newline > Ulineno)
  772.                 THEN next_window(wind[n],newline-Ulineno);
  773.         END;
  774.     END;
  775.  
  776.     PROCEDURE Do_Size;
  777.     { Change the size of the current window, and remember the new size }
  778.     VAR
  779.       n : integer;
  780.     BEGIN
  781.       n := Match_Window(message[3]);
  782.       WITH wind[n] DO
  783.         BEGIN
  784.           Set_Wsize(handle,message[4],message[5],message[6],message[7]);
  785.           smallx := message[4];
  786.           smally := message[5];
  787.           smallw := message[6];
  788.           smallh := message[7];
  789.           windx := smallx;
  790.           windy := smally;
  791.           windw := smallw;
  792.           windh := smallh;
  793.           Update_Slides(wind[n]);
  794.         END;
  795.     END;
  796.  
  797.     PROCEDURE Do_Move;
  798.     { Move the current window to a new place }
  799.     VAR
  800.       n : integer;
  801.     BEGIN
  802.       n := Match_Window(message[3]);
  803.       WITH wind[n] DO
  804.         BEGIN
  805.           Set_Wsize(handle,message[4],message[5],message[6],message[7]);
  806.           smallx := message[4];
  807.           smally := message[5];
  808.           smallw := message[6];
  809.           smallh := message[7];
  810.           windx := smallx;
  811.           windy := smally;
  812.           windw := smallw;
  813.           windh := smallh;
  814.           Update_Slides(wind[n]);
  815.         END;
  816.     END;
  817.  
  818.     PROCEDURE Do_Nothing;
  819.     BEGIN
  820.     END;
  821.  
  822.     BEGIN
  823.       CASE message[0] of
  824.         MN_Selected : Do_Selection;
  825.         WM_Redraw   : Do_Redraw;
  826.         WM_Topped   : Do_Newtop;
  827.         WM_Closed   : Do_Close;
  828.         WM_Fulled   : Do_Fulled;
  829.         WM_Arrowed  : Do_Arrowed;
  830.         WM_HSlid    : Do_Hor;
  831.         WM_Vslid    : Do_Ver;
  832.         WM_Sized    : Do_Size;
  833.         WM_Moved    : Do_move;
  834.         Otherwise   : Do_Nothing;
  835.       END;
  836.     END;
  837.  
  838.     PROCEDURE Do_Keyboard;
  839.     VAR
  840.       temp : integer;
  841.     BEGIN
  842.       IF key = $06200 THEN { HELP Key pushed }
  843.         temp := Do_Alert('[1][ I can''t fix your problems ][ Continue ]',1);
  844.       IF key = $06100 THEN { UNDO Key pushed }
  845.       BEGIN
  846.         temp :=
  847.           Do_Alert('[3][ Do you really want to Quit? ][ Quit | Continue ]',2);
  848.           running := (temp <> 1);  { Return FALSE to Quit! }
  849.       END;
  850.     END;
  851.  
  852.     PROCEDURE New_Mouse(f:Boolean; n:Integer);
  853.     VAR
  854.       i : Integer;
  855.     BEGIN
  856.       IF f THEN i := 1 ELSE i := 0;
  857.       i := i + (n * 2);
  858.       CASE i OF
  859.         0: Set_Mouse(M_Point_Hand);
  860.         1: Set_Mouse(M_Outln_Cross);
  861.         2: Set_Mouse(M_Arrow);
  862.         3: Set_Mouse(M_Thin_Cross);
  863.         OtherWise: Set_Mouse(M_Bee);
  864.       END;
  865.     END;
  866.  
  867.     PROCEDURE Do_Button;
  868.     { Mostly for form, change the cursor when the left Button changes }
  869.     BEGIN
  870.       B_Left := 1 - B_Left;
  871.       New_Mouse(InWindow,B_Left);
  872.     END;
  873.  
  874.     PROCEDURE Do_Rect1;
  875.     { Mostly for form, use the cursor shape to track if the mouse is in
  876.       or out of the active window }
  877.     BEGIN
  878.       InWindow := Not InWindow;
  879.       New_Mouse(InWindow,B_Left);
  880.     END;
  881.  
  882.     PROCEDURE Do_Timer;
  883.     { This one's just here to fill out the template }
  884.     VAR
  885.       i : integer;
  886.       r : real;
  887.       message : String;
  888.       rval : String;
  889.     BEGIN
  890.       r := (Get_Timer - Ticks) / 1000.0; { Convert to seconds elapsed }
  891.       Str(r,rval);
  892.       message := Concat('[1][ Program run | ', rval,
  893.                         ' | seconds ][ Continue ]');
  894.       i := Do_Alert(message,1);
  895.     END;
  896.  
  897. BEGIN  { Wait for a GEM message or a keyboard event }
  898.   Work_Rect(Front_Window,Cur_X,Cur_Y,Cur_W,Cur_H);
  899.   i := Get_Event(E_Keyboard|E_Message|E_Button|E_Mrect_1|E_Timer,
  900.                  1, B_Left, 1,  { Wait for left button Change }
  901.                  Delay,         { Wait for timeout }
  902.                  InWindow,Cur_X,Cur_Y,Cur_W,Cur_H, { Front Window border }
  903.                  False,0,0,0,0, { No Rectangle 2 }
  904.                  message,       { Returns message if E_Message }
  905.                  key,           { Returns key pressed if E_Keyboard }
  906.                  bcnt,          { Returns button count if E_Button }
  907.                  bstate,        { Returns button status if E_Button }
  908.                  mx, my,        { Mouse position if E_Button }
  909.                  kbd_state);    { Keyboard state if E_Keyboard }
  910.  
  911.   IF (i & E_Message) <> 0  THEN Do_Message;
  912.   IF (i & E_Keyboard) <> 0 THEN Do_Keyboard;
  913.   IF (i & E_Timer) <> 0 THEN Do_Timer;
  914.   IF (i & E_MRect_1) <> 0 THEN Do_Rect1;
  915.   IF (i & E_Button) <> 0 THEN Do_Button;
  916.  
  917. END; { Procedure Process }
  918.  
  919. PROCEDURE Clean_up;
  920. VAR
  921.   i : integer;
  922. BEGIN
  923.   FOR I := 1 to Max_wind DO
  924.     IF wind[i].InUse THEN
  925.       BEGIN
  926.         Close_Window(wind[i].handle);
  927.         Delete_Window(wind[i].handle);
  928.       END;
  929.   IF mouse_init THEN Set_Mouse(M_Arrow);
  930.   IF menu_init THEN
  931.     BEGIN
  932.       Erase_Menu(mymenu);
  933.       Delete_Menu(mymenu);
  934.     END;
  935.   Exit_Gem;
  936. END;
  937.  
  938. PROCEDURE Go_For_It; { This is where it happens, Jack }
  939. BEGIN
  940.   running := false;
  941.   Start_up;
  942.   While running do Process;
  943.   Clean_up;
  944. END;
  945.  
  946. BEGIN { template }
  947.   IF Init_Gem >= 0 THEN Go_For_It;
  948. END. { PROGRAM template }
  949.